8bitfiles.net/archives/archives.tar/archives/compuserve-file-archive/15 Orphan Computers/SIMCAL.TXT

Text File | 2019-04-13 | 10KB | 322 lines

 10 dim v(15,60),x$(50),v$(15,60):cr$=chr$(147):ct$="-----calculating ----"
 20 dim l$(50):printcr$
 30 printcr$
 35 print"------column calculator-------"
 40 print"    1.  view columns
 50 print"    2.  enter data
 60 print"    3.  do calculations
 70 print"    4.  zero matrix
 80 print"    5.  get data from tape
 90 print"    6.  put data back on tape
 100 print"    7.  memory check
 110 print"    8. print data on printer"
 120 print
 130 print"    what is your choice?"
 140 get an$:if an$="" then 140
 150 on val(an$)gosub 250,1120,1270,180,740,910,1070,2860
 160 goto 30
 170 rem zero  matrix
 180 printcr$
 185 print"zeroing matrix..col >           "
 190 for x=1 to 15:printchr$(145)tab(22)x
 200 for y=1 to 50
 210 v(x,y)=0
 220 nexty
 230 nextx
 240 return
 250 rem set  up display
 260 printcr$
 270 input "enter column(1 to 13):";c%
 280 if c%<1 or c%>13 then printcr$;:goto270
 290 print:input "enter row (1 to 31):";r%
 300 if r%<1 or r%>31 then printcr$;:goto290
 310 printcr$;:gosub 580
 320 printchr$(19)chr$(17)
 330 for y=r% to r%+19
 340 printtab(9);
 350 for x=c% to c%+2
 360 x$=str$(v(x,y))
 370 printspc(10-len(x$));x$;
 380 next
 390 printchr$(13);
 400 next
 410 printchr$(17)"enter (u)p,(d)wn,(l)ft,(r)ht,(j)mp or (m)enu";
 420 get c$:if c$="" then 420
 430 rem if c$=up then decrease row by 1
 440 if c$="u" then r%=r%-1:printchr$(13):goto300
 450 rem if c$=down then increase row by 1
 460 if c$="d" then r%=r%+1:printchr$(13):goto300
 470 rem if c$=left then decrease colm by 1
 480 if c$="l" then c%=c%-1:goto550
 490 rem if c$=right then increase colm by 1
 500 if c$="r" then c%=c%+1:goto550
 510 rem if c$=jump enter new row and colm if c$=m,go back to menu
 520 if c$="j" then 260
 530 if c$="m" then return
 540 goto 420:rem reject any other c$ input
 550 if c%<1 then c%=1:goto420
 560 ifc%>13thenc%=13:goto420
 570 goto 310
 580 rem create row and colm headers
 590 printtab(9);
 600 for i=1 to 3
 610 printchr$(18)"    column";
 620 next
 630 printchr$(13);tab(9);
 640 for i=c% to c%+2
 650 s%=7:if i<10 then s%=8
 660 printspc(s%);chr$(18);str$(i);chr$(146);
 670 next
 680 printchr$(13);
 690 for i=r% to r%+19
 700 s%=1:if i<10 then s%=2
 710 printtab(2)chr$(18);"row";spc(s%);str$(i)"
 720 next
 730 return
 740 rem get data from tape
 750 input"what is name of file you want";fl$
 760 print:print"make sure tape is ready..push any key when ready"
 770 print"push 'm' to return to menu"
 780 geta$:ifa$=""then780
 790 ifa$="m"then return
 800 printcr$"looking for ";fl$
 810 open1,1,0,(fl$)
 820 print"found ";fl$;" .....loading"
 830 for x=1 to 12:print"loading data into col"x
 840 for y=1 to 49
 850 input#1,v(x,y)
 860 next y
 870 next x
 880 close 1:print"ok.....got data"
 890 for i=1 to 1000:next i
 900 return
 910 rem put data on disk
 920 input"what do you want to name this file";fl$
 930 print"make sure tape is rewound,hit any key when ready"
 940 print"push 'm' to return to menu"
 950 geta$:if a$="" then 950
 960 ifa$="m"then return
 970 printcr$"----putting data on disk--------   "
 980 open1,1,2,(fl$)
 990 for x=1 to 12:print"storing data from col"x
 1000 for y=1 to 49
 1010 print#1,v(x,y)
 1020 next y
 1030 next x
 1040 close1:print"ok.....data on disk"
 1050 for i=1 to1000:next i
 1060 return
 1070 rem memeory check
 1080 printfre(a)
 1090 for i=1 to 1000:next i
 1100 return
 1110 rem enter data routine
 1120 printcr$:print
 1130 print"what column number do you wish(1-12)
 1140 inputcl
 1150 if cl=13 or cl=14 or cl=15 thenprint"reserved for totals":goto1130
 1160 print:print"how many rows do you want to work with(1-50)"
 1170 inputk
 1180 print:print"row","current","column";cl
 1190 for y=1 to k
 1200 print:printy,v(cl,y),:fori=1to11:printchr$(157);:next:inputv:v(cl,y)=v
 1210 next y
 1220 print"enter 'c' for another column"
 1230 print"'m' for the menu.";
 1240 getd$:if d$="" then 1240
 1250 ifd$="c"then 1120
 1260 return
 1270 rem calculation menu
 1280 printcr$
 1290 print"you may choose any of the following"
 1300 print"  1. sum all columns...............1450
 1310 print"  2. sum all rows..................1600
 1320 print"  3. reproduce any column..........1710
 1330 print"  4. add,mult,div,sub,at any point.1790
 1340 print"  5. average all columns...........2170
 1350 print"  6. all rows as % of base row.....2250
 1360 print"  7. all col as % of base col......2370
 1370 print"  8. sum individual col........... 2560
 1380 print"  9. unused                ........2510
 1390 print" 'm' returns you to main menu"
 1400 print:print"which one?";
 1410 get an$:if an$=""then1410
 1420 if an$="m" then return
 1430 on val(an$)gosub 1450,1600,1710,1790,2170,2250,2370,2560,2490
 1440 goto1280
 1450 rem sum all colmns
 1460 printcr$"do you wish to designate the rows to  be summed?"
 1470 geta$:ifa$=""then1470
 1480 ifa$="n"then s1=1:s2=49:goto 1500
 1490 print:input"sum rows between s1,s2";s1,s2
 1500 printcr$;ct$:print"summing columns >               "
 1510 for x=1 to 14
 1520 v(x,s2+1)=0
 1530 next x
 1540 for x=1 to 14:printchr$(145)tab(22)x
 1550 for y=s1to s2
 1560 v(x,s2+1)=v(x,s2+1)+v(x,y)
 1570 next y
 1580 next x
 1590 return
 1600 rem sum all rows
 1610 printcr$;ct$:print"summing rows >                  "
 1620 for y=1 to 48
 1630 v(13,y)=0
 1640 next y
 1650 for y=1 to 48:printchr$(145)tab(22)y
 1660 for x=1 to 12
 1670 v(13,y)=v(13,y)+v(x,y)
 1680 next x
 1690 next y
 1700 return
 1710 rem reproduce any col
 1720 printcr$:input"which col do you wish";cx
 1730 printcr$;ct$:print"duplicating col"cx" into col >            "
 1740 for x=cx+1 to 12:printchr$(145)tab(32)x
 1750 for y=1 to 49
 1760 v(x,y)=v(cx,y)
 1770 next y:next x
 1780 return
 1790 rem add,mult,sub,div,exchg at any point
 1800 printcr$"do you wish to "
 1810 print"  1.add  2.mult  3.sub  4.div  5.exchg "
 1820 geta$:if a$="" then 1820
 1830 if val(a$)<1 or val(a$)>5 then 1800
 1840 on val(a$)goto 1850,1910,1970,2030,2100
 1850 rem add
 1860 input"enter the amount you want added";ad
 1870 input"what col #";x
 1880 input"what row #";y
 1890 v(x,y)=v(x,y)+ad
 1900 goto 2160
 1910 rem mult routine
 1920 printcr$:input"enter the amount to mult by";ml
 1930 input"what col #";x
 1940 input"what row #";y
 1950 v(x,y)=v(x,y)*ml
 1960 goto 2160
 1970 rem sub routine
 1980 printcr$:input"enter the amount to be sub";sb
 1990 input"what col #";x
 2000 input"what row #";y
 2010 v(x,y)=v(x,y)-sb
 2020 goto 2160
 2030 rem div routine
 2040 printcr$:input"enter the amount to div by";dv
 2050 input"what col #";x
 2060 input"what row #";y
 2070 v(x,y)=v(x,y)/dv
 2080 v(x,y)=int(v(x,y)*1000+.5)/1000
 2090 goto 2160
 2100 rem exchg routine
 2110 printcr$:input"enter amount to be exchged";ex
 2120 input"what col #";x
 2130 input"what row #";y
 2140 v(x,y)=ex
 2150 goto 2160
 2160 return
 2170 rem average the col
 2180 printcr$:input"enter the number of cols to be averaged";ave
 2190 printcr$;ct$:print"averaging columns.. row >        "
 2200 for y=1 to 50:printchr$(145)tab(27)y
 2210 if v(13,y)=0 then 2230
 2220 v(14,y)=v(13,y)/ave:v(14,y)=int(v(14,y)*1000+.5)/1000
 2230 next y
 2240 return
 2250 rem rows as %of base row
 2260 printcr$:input"which is your base row";br
 2270 printcr$;ct$:print"all rows as % of row"br
 2280 print"calculating col >            "
 2290 for x=1 to 13:printchr$(145)tab(20)x
 2300 for y=1 to 50
 2310 if y=br then2340
 2320 if v(x,br)=0 then 2340
 2330 v(x,y)=v(x,y)/v(x,br):v(x,y)=int(v(x,y)*10000+.5)/100
 2340 next y
 2350 next x
 2360 return
 2370 rem all col as % of base col
 2380 printcr$:input"which is your base col";cx
 2390 printcr$;ct$:print"all cols as % of col"cx
 2400 print"calculating row >              "
 2410 for y=1 to 50:printchr$(145)tab(20)y
 2420 for x=1 to 12
 2430 if x=cx then 2460
 2440 if v(cx,y)=0 then 2460
 2450 v(x,y)=v(x,y)/v(cx,y):v(x,y)=int(v(x,y)*10000+.5)/100
 2460 next x
 2470 next y
 2480 return
 2490 rem this section not used
 2500 return
 2510 :
 2520 :
 2530 :
 2540 :
 2550 :
 2560 rem sum single col
 2570 printchr$(147)"Which col do you want to sum?"
 2580 inputca: ifca<1orca>15then2580
 2590 print:print"do you wish to sum certain  rows (y/n)?"
 2600 getyn$:ifyn$<>"y"andyn$<>"n"then2600
 2610 ifyn$="y"thengosub 2680:goto2630
 2620 s1=1:s2=49
 2630 v(ca,s2+1)=0
 2640 fory=s1tos2
 2650 v(ca,s2+1)=v(ca,s2+1)+v(ca,y)
 2660 nexty
 2670 return
 2680 rem set  up designated rows
 2690 input"enter rows to be summed in this col (s1,s2)";s1,s2
 2700 return
 2710 rem set up series of calc
 2720 print:print"how many calculations do you want in this  series (1-8)?"
 2730 getnm$:ifnm$=""then2730
 2740 ifval(nm$)<0orval(nm$)>8then2730
 2750 nm=val(nm$):ifnm=0thenreturn
 2760 print"enter operations you choose in the order they are to be performed"
 2770 fori=1tonm
 2780 print"enter operation #";i;
 2790 getop(i):ifop(i)<1orop(i)>8then2790
 2800 printop(i)
 2810 nexti
 2820 fori=1tonm
 2830 onop(i)gosub 1450,1600,1710,1790,2170,2250,2370,2560
 2840 nexti
 2850 return
 2860 rem print  data routine
 2870 printchr$(147)"make sure printer is on dummy...hit any key when ready."
 2880 print"hit 'm' to return to menu"
 2890 geta$:ifa$=""then2890
 2900 ifa$="m"then return
 2910 print"do you want  to  designate the rows to be printed?"
 2920 geta$:ifa$=""then2920
 2930 ifa$="n"then s1=1:s2=50:goto2960
 2940 input"enter rows to be printed s1,s2";s1,s2
 2950 sp$=chr$(29)
 2960 open 3,4,0:open 2,4,2:open 1,4,1:open4,4,4
 2970 print#2,"aaa 99  aaaaaaaa  99999999  99999999  999.99   s99999999
 2980 print#3,"col",," 1"," 2"," 3"," 4"
 2990 print#3,
 3000 fory=s1tos2
 3010 print#1,"row"sp$,y,,v(1,y),v(2,y),v(3,y),v(4,y)
 3020 nexty:print#3:goto3160
 3030 print#3,"col",," 5"," 6"," 7"," 8"
 3040 fory=s1tos2
 3050 print#1,"row"sp$,y,,v(5,y),v(6,y),v(7,y),v(8,y)
 3060 nexty:print#3
 3070 print#3,"col",," 9","10","11","12"
 3080 fory=s1tos2
 3090 print#1,"row"sp$,y,l$(y)sp$,v(9,y),v(10,y),v(11,y),v(12,y)
 3100 nexty:print#3
 3110 print#2,"aaa 99  aaaaaaaa  9999999.99  9999999.99  9999999.99"
 3120 print#3,"col",,"13","14","15"
 3130 fory=s1tos2
 3140 print#1,"row"sp$,y,,v(13,y),v(14,y),v(15,y)
 3150 nexty
 3160 print#4:close4:close3:close2:close1: return
ready.